Network Analysis en R

Tenemos esta información:

1. Importando datos

FileName='dataFigueroa.csv'
adjacency=read.csv(FileName)

El formato es una matriz de adyacencia, por lo que debería ser cuadrada:

dim(adjacency)
## [1] 37 39

Sucede que la ultima columna es un atributo, y la primera repite los apellidos:

names(adjacency)
##  [1] "Names"               "Romero"              "Grana"              
##  [4] "Miro.Quesada"        "Moreyra"             "Fort"               
##  [7] "De.La.Puente"        "Wiese"               "Onrubia"            
## [10] "Brescia"             "Nicolini"            "Montero"            
## [13] "Picaso"              "Bentin"              "Benavides"          
## [16] "Bustamante"          "Woodman.Pollit"      "Raffo"              
## [19] "Piazza"              "Berckemeyer"         "Llosa.Barber"       
## [22] "Beoutis.Ledesma"     "Rizo.Patron"         "Montori"            
## [25] "Sotomayor"           "Cilloniz"            "Ferreyros"          
## [28] "Michell"             "Wong.Lu"             "Batievsky.Spack"    
## [31] "Matos.Escalada"      "Galsky"              "Lucioni"            
## [34] "Rodriguez.Rodriguez" "Custer"              "Ikeda"              
## [37] "Cogorno"             "Arias.Davila"        "multinational"

Guardemos apellidos y atributo:

attributes=adjacency[,c('Names','multinational')]
head(attributes)
##          Names multinational
## 1       Romero             1
## 2        Grana             1
## 3 Miro Quesada             1
## 4      Moreyra             1
## 5         Fort             1
## 6 De La Puente             1

Pasemos el atributo a categoría:

attributes$multinational=factor(attributes$multinational,levels = c(0,1),labels = c("No", "Si"),ordered = F)

Ahora, pasemos Names como nombre de fila:

row.names(adjacency)=adjacency$Names
adjacency$Names=NULL
adjacency$multinational=NULL

# asi:
head(adjacency)
##              Romero Grana Miro.Quesada Moreyra Fort De.La.Puente Wiese Onrubia
## Romero            0     1            1       1    1            1     0       1
## Grana             1     0            1       0    1            1     1       0
## Miro Quesada      1     1            0       0    1            1     1       0
## Moreyra           1     0            0       0    1            1     1       1
## Fort              1     1            1       1    0            1     0       1
## De La Puente      1     1            1       1    1            0     1       0
##              Brescia Nicolini Montero Picaso Bentin Benavides Bustamante
## Romero             1        1       0      0      1         1          1
## Grana              0        0       1      0      0         1          1
## Miro Quesada       0        0       1      0      0         1          1
## Moreyra            1        0       1      1      1         0          1
## Fort               1        1       0      1      1         1          1
## De La Puente       0        0       1      0      0         1          1
##              Woodman.Pollit Raffo Piazza Berckemeyer Llosa.Barber
## Romero                    1     1      1           1            1
## Grana                     0     0      1           0            0
## Miro Quesada              0     0      1           0            0
## Moreyra                   0     1      0           1            0
## Fort                      1     1      1           0            1
## De La Puente              0     0      1           1            0
##              Beoutis.Ledesma Rizo.Patron Montori Sotomayor Cilloniz Ferreyros
## Romero                     0           1       1         0        0         0
## Grana                      1           0       0         0        0         0
## Miro Quesada               1           0       0         0        0         0
## Moreyra                    0           1       1         1        0         0
## Fort                       1           0       0         1        1         0
## De La Puente               1           1       0         1        0         0
##              Michell Wong.Lu Batievsky.Spack Matos.Escalada Galsky Lucioni
## Romero             0       0               0              0      0       0
## Grana              1       0               0              0      0       0
## Miro Quesada       1       0               0              0      0       0
## Moreyra            0       0               0              0      0       0
## Fort               0       0               0              0      0       0
## De La Puente       0       0               0              0      0       0
##              Rodriguez.Rodriguez Custer Ikeda Cogorno Arias.Davila
## Romero                         0      0     0       0            0
## Grana                          0      0     0       0            0
## Miro Quesada                   0      0     0       0            0
## Moreyra                        0      0     0       0            0
## Fort                           0      0     0       0            0
## De La Puente                   0      0     0       0            0

Nota que la estructura es data frame:

class(adjacency)
## [1] "data.frame"

Pasemosla a matriz.

adjacency=as.matrix(adjacency) 

Llevemos la matriz a grafo con la ayuda de Igraph:

library(igraph)
EliteNet=graph.adjacency(adjacency,mode="undirected",weighted=NULL)
# see it here
EliteNet
## IGRAPH 9371efd UN-- 37 135 -- 
## + attr: name (v/c)
## + edges from 9371efd (vertex names):
##  [1] Romero--Grana          Romero--Miro.Quesada   Romero--Moreyra       
##  [4] Romero--Fort           Romero--De.La.Puente   Romero--Onrubia       
##  [7] Romero--Brescia        Romero--Nicolini       Romero--Bentin        
## [10] Romero--Benavides      Romero--Bustamante     Romero--Woodman.Pollit
## [13] Romero--Raffo          Romero--Piazza         Romero--Berckemeyer   
## [16] Romero--Llosa.Barber   Romero--Rizo.Patron    Romero--Montori       
## [19] Grana --Miro.Quesada   Grana --Fort           Grana --De.La.Puente  
## [22] Grana --Wiese          Grana --Montero        Grana --Benavides     
## + ... omitted several edges

Un grafo está compuesto de nodos o vertices, y edges o enlaces que los conectan, Aquí podemos ver cuántos hay de cada uno:

vcount(EliteNet) #conteo de nodos
## [1] 37
ecount(EliteNet) #conteo de enlaces
## [1] 135

Gráficamente:

plot.igraph(EliteNet,
            vertex.color = 'yellow',
            edge.color='lightblue')

Añadimos los atributos:

EliteNet=set_vertex_attr(EliteNet,"multi",value=attributes$multinational)

#then
EliteNet
## IGRAPH 9371efd UN-- 37 135 -- 
## + attr: name (v/c), multi (v/n)
## + edges from 9371efd (vertex names):
##  [1] Romero--Grana          Romero--Miro.Quesada   Romero--Moreyra       
##  [4] Romero--Fort           Romero--De.La.Puente   Romero--Onrubia       
##  [7] Romero--Brescia        Romero--Nicolini       Romero--Bentin        
## [10] Romero--Benavides      Romero--Bustamante     Romero--Woodman.Pollit
## [13] Romero--Raffo          Romero--Piazza         Romero--Berckemeyer   
## [16] Romero--Llosa.Barber   Romero--Rizo.Patron    Romero--Montori       
## [19] Grana --Miro.Quesada   Grana --Fort           Grana --De.La.Puente  
## [22] Grana --Wiese          Grana --Montero        Grana --Benavides     
## + ... omitted several edges

tienes:

vertex_attr_names(EliteNet) 
## [1] "name"  "multi"

Esta red estará “conectada”:

is_connected(EliteNet)
## [1] FALSE

Cuantos “componentes”?

components(EliteNet)$no
## [1] 8

Quienes en cada componente:

groups(components(EliteNet))
## $`1`
##  [1] "Romero"          "Grana"           "Miro.Quesada"    "Moreyra"        
##  [5] "Fort"            "De.La.Puente"    "Wiese"           "Onrubia"        
##  [9] "Brescia"         "Nicolini"        "Montero"         "Picaso"         
## [13] "Bentin"          "Benavides"       "Bustamante"      "Woodman.Pollit" 
## [17] "Raffo"           "Piazza"          "Berckemeyer"     "Llosa.Barber"   
## [21] "Beoutis.Ledesma" "Rizo.Patron"     "Montori"         "Sotomayor"      
## [25] "Cilloniz"        "Ferreyros"       "Michell"         "Wong.Lu"        
## 
## $`2`
## [1] "Batievsky.Spack" "Matos.Escalada"  "Galsky"         
## 
## $`3`
## [1] "Lucioni"
## 
## $`4`
## [1] "Rodriguez.Rodriguez"
## 
## $`5`
## [1] "Custer"
## 
## $`6`
## [1] "Ikeda"
## 
## $`7`
## [1] "Cogorno"
## 
## $`8`
## [1] "Arias.Davila"

Componente como atributo:

component=components(EliteNet)$membership
EliteNet=set_vertex_attr(EliteNet,"component",value=component)
#asi:
EliteNet
## IGRAPH 9371efd UN-- 37 135 -- 
## + attr: name (v/c), multi (v/n), component (v/n)
## + edges from 9371efd (vertex names):
##  [1] Romero--Grana          Romero--Miro.Quesada   Romero--Moreyra       
##  [4] Romero--Fort           Romero--De.La.Puente   Romero--Onrubia       
##  [7] Romero--Brescia        Romero--Nicolini       Romero--Bentin        
## [10] Romero--Benavides      Romero--Bustamante     Romero--Woodman.Pollit
## [13] Romero--Raffo          Romero--Piazza         Romero--Berckemeyer   
## [16] Romero--Llosa.Barber   Romero--Rizo.Patron    Romero--Montori       
## [19] Grana --Miro.Quesada   Grana --Fort           Grana --De.La.Puente  
## [22] Grana --Wiese          Grana --Montero        Grana --Benavides     
## + ... omitted several edges

Graficamente:

Labels=component
numberOfClasses = length(unique(Labels)) 

#preparando color
library(RColorBrewer)
colorForScale='Set2'
colors = brewer.pal(numberOfClasses, colorForScale)

# graficando
plot.igraph(EliteNet,
             vertex.color = colors[Labels],
             edge.color='lightblue')

Quedemonos con el Giant Component:

  1. conteos:
(Sizes=components(EliteNet)$csize)
## [1] 28  3  1  1  1  1  1  1
  1. eligiendo:
EliteNet_giant=induced.subgraph(EliteNet, which(Labels == which.max(Sizes)))

veamos al Giant Component:

plot.igraph(EliteNet_giant)

Resumen:

summary(EliteNet_giant)
## IGRAPH 8431446 UN-- 28 133 -- 
## + attr: name (v/c), multi (v/n), component (v/n)

2. Exploración

Metricas totales:

  • Densidad (Density): va de 0 a 1. 1 significa que hay un link entre cada par de nodos.
graph.density(EliteNet_giant)
## [1] 0.3518519
  • Diameter: El mayor de los geodesicos (el sendero(path) menor entre cualquier par de nodos)

diameter(EliteNet_giant)
## [1] 4
  • El coeficiente de agrupamiento (clustering coefficient) cuantifica qué tanto está agrupado un nodo con sus vecinos. Si está conectado con todos es 1. Así, coeficiente de agrupamiento local es el promedio de esos valores.
transitivity(EliteNet_giant,type = 'average')
## [1] 0.6537019
  • Shortest path (average): es el promedio de todos los senderos menores de la red.
average.path.length(EliteNet_giant)
## [1] 1.740741

Random networks tienen pequeños shortest path and pequeño clustering coefficient.

  • Transitivity: qué tan probable es que dos nodes con algun contacto en común tambíen estén conectados.
transitivity(EliteNet_giant)
## [1] 0.5829694
  • Assortativity (degree): Mide la tendencia a conectarse con nodos de grado similar. Mientras mas cerca a 1 hay mayor assortativity, mas cerca a -1 diassortativity; pero 0 es ausencia de assortitivity.
assortativity_degree(EliteNet_giant)
## [1] -0.1208671

No solo para grado de conexiones, sino otro atributo:

attrNet=V(EliteNet_giant)$multi
assortativity_nominal(EliteNet_giant,attrNet)
## [1] -0.07258065

Coloreando por atributo:

LabelsColor=attrNet
colors=c('lightblue','magenta')
plot.igraph(EliteNet_giant,
       vertex.color = colors[LabelsColor])

Comunidades

  • La red presenta cliques? (conjunto de nodos donde todos están conectados mutuamente)
length(cliques(EliteNet_giant))
## [1] 1074

Un clique puede estar anidado. Si un clique no puede crecer más (dejando de ser clique): maximal clique.

  • Cuántos maximal cliques?
count_max_cliques(EliteNet_giant)
## [1] 28

Tamaño del maximal clique:

clique_num(EliteNet_giant)
## [1] 8
  • Cuales son los más grandes?
max_cliques(EliteNet_giant,min=8)
## [[1]]
## + 8/28 vertices, named, from 8431446:
## [1] Onrubia        Romero         Raffo          Bentin         Fort          
## [6] Llosa.Barber   Woodman.Pollit Nicolini      
## 
## [[2]]
## + 8/28 vertices, named, from 8431446:
## [1] Onrubia     Romero      Raffo       Bentin      Berckemeyer Montori    
## [7] Brescia     Moreyra    
## 
## [[3]]
## + 8/28 vertices, named, from 8431446:
## [1] Benavides    Romero       Piazza       Bustamante   De.La.Puente
## [6] Fort         Miro.Quesada Grana

Si hay cliques, es claro que hay comunidades. Detectar comunidades es un área enorme de investigación, usemos uno de los algoritmos conocido como el método Louvain.

communities=cluster_louvain(EliteNet_giant)
(partition=membership(communities))
##          Romero           Grana    Miro.Quesada         Moreyra            Fort 
##               2               1               1               3               1 
##    De.La.Puente           Wiese         Onrubia         Brescia        Nicolini 
##               1               3               2               2               2 
##         Montero          Picaso          Bentin       Benavides      Bustamante 
##               1               3               2               1               1 
##  Woodman.Pollit           Raffo          Piazza     Berckemeyer    Llosa.Barber 
##               2               2               1               2               2 
## Beoutis.Ledesma     Rizo.Patron         Montori       Sotomayor        Cilloniz 
##               1               3               2               3               3 
##       Ferreyros         Michell         Wong.Lu 
##               1               1               2

Ahora, usamos esos valores para resaltar las comunidades:

Labels=partition
numberOfClasses = length(unique(Labels)) 

library(RColorBrewer)
colorForScale='Set2'
colors = brewer.pal(numberOfClasses, colorForScale)

plot.igraph(EliteNet_giant,
             vertex.color = colors[Labels],
             edge.color='lightblue')

Exploración de actores de la red

Prestemos atención a los individuos de la red. Calculemos:

  • El grado o degree de un nodo: la cantidad de enlaces que inciden en él.
  • La cercania o closeness: Se basa en calcular la suma o bien el promedio de las distancias geodésicas (o longitudes de los caminos más cortos) desde un nodo hacia todos los demás.
  • La intermediación o betweenness:que cuantifica la frecuencia o el número de veces que un nodo se encuentra entre las geodésicas o caminos más cortos de otros actores.
rounding=3
degr=round(degree(EliteNet_giant,normalized=T),rounding)
close=round(closeness(EliteNet_giant,normalized=T),rounding)
betw=round(betweenness(EliteNet_giant,normalized=T),rounding)

DFCentrality=as.data.frame(cbind(degr,close,betw),stringsAsFactors = F)
names(DFCentrality)=c('Degree','Closeness','Betweenness')
DFCentrality$person=row.names(DFCentrality)
row.names(DFCentrality)=NULL
head(DFCentrality)
##   Degree Closeness Betweenness       person
## 1  0.667     0.750       0.102       Romero
## 2  0.407     0.614       0.043        Grana
## 3  0.407     0.614       0.043 Miro.Quesada
## 4  0.556     0.675       0.066      Moreyra
## 5  0.704     0.771       0.155         Fort
## 6  0.519     0.659       0.039 De.La.Puente

Graficamente:

library(ggplot2)
ggplot(DFCentrality, aes(x=Betweenness, y=Closeness)) + theme_classic()+
  scale_size(range = c(1, 25))  + geom_text(aes(label=person,color=Degree)) +
  scale_colour_gradient(low = "orange", high = "black")

El nodo con el mayor degree se puede considerar un hub de la red:

DFCentrality[which.max(DFCentrality$Degree),]
##   Degree Closeness Betweenness person
## 5  0.704     0.771       0.155   Fort

Veamos la red del hub, o su ego network:

  1. Determiner el nombre del hub:
#who
hub=DFCentrality[which.max(DFCentrality$Degree),]$person
  1. Determinar la posición del hub:
#where
hubix=as.numeric(row.names(DFCentrality[DFCentrality$person==hub,]))
  1. Pedir la red ego del hub:
HubEgonets=make_ego_graph(EliteNet_giant, nodes=hubix)
# HubEgonets es una list, pedimos el primer elemento:
HubEgonet=HubEgonets[[1]]
  1. Just plot the ego you got:
egoSizes=rep(5,vcount(HubEgonet)) # tamaño de todos
egoSizes[hubix]=40  # tamaño del ego
V(HubEgonet)$size=egoSizes 
plot.igraph(HubEgonet,
             vertex.color = 'yellow',
             edge.color='lightblue')

Podríamos partir el giant component?

Numero mínimo de nodos para desconectarlo:

vertex_connectivity(EliteNet_giant)
## [1] 1

quienes la pueden partir?

articulation_points(EliteNet_giant)
## + 1/28 vertex, named, from 8431446:
## [1] Bentin
V(EliteNet_giant)$color = ifelse(V(EliteNet_giant) %in%
                    articulation_points(EliteNet_giant),   
                    "salmon", "lightblue")
V(EliteNet_giant)$size = ifelse(V(EliteNet_giant) %in%
                    articulation_points(EliteNet_giant),   
                    40, 10)


plot.igraph(EliteNet_giant,
             edge.color = 'yellow',
            vertex.shape='sphere')

Exportando la red

write_graph(EliteNet, "EliteNetR.graphml", "graphml")